home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _FILEROO.PRG < prev    next >
Text File  |  1993-05-04  |  2KB  |  68 lines
  1. FUNCTION _FileRoot
  2. PARAMETER pc_fname
  3. *--------------------------------------------------------------------
  4. * NAME
  5. *   _FILEROOT - Returns "root" of a filename.
  6. *
  7. * SYNOPSIS
  8. *   _FILEROOT( pc_fname )
  9. *
  10. * DESCRIPTION
  11. *   _FILEROOT() isolates the filename, up to the first eight
  12. *   characters, from a full path description.  That is, the
  13. *   file extension, if any, is not returned.  Note that the
  14. *   following can all be valid filespecs within dBASE:
  15. *     FOO
  16. *     FOO.BAR
  17. *     C:FOO
  18. *     C:FOO.BAR
  19. *     C:\FOO
  20. *     C:\FOO.BAR
  21. *     C:\FOO\FOO
  22. *     C:\FOO\FOO.BAR
  23. *     C:\FOO.BAR\FOO
  24. *     C:\FOO.BAR\FOO.BAR
  25. *     ..\FOO.BAR
  26. *
  27. *   No upper or lower case conversion occurs.
  28. *
  29. * PARAMETER
  30. *   pc_fname - A character full DOS filespec.
  31. *
  32. * EXAMPLE
  33. *   lc_root = _FileRoot( "C:\TEST\FOO.PRG" )
  34. *     ( lc_root will equal "FOO" )
  35. *
  36. * SEE ALSO
  37. *   _FILEDRV(), _FILEPATH(), _FILETYPE()
  38. *
  39. *--------------------------------------------------------------------
  40.  
  41.   PRIVATE lc_result, lc_slash
  42.  
  43.   IF LEFT( OS(), 3 ) = "DOS"
  44.     lc_slash = "\"
  45.   ELSE
  46.     lc_slash = "/"
  47.   ENDIF
  48.  
  49.   *-- Add "." to end to easily handle file with no extension:
  50.   lc_result = LTRIM( RTRIM( pc_fname ) ) + "."
  51.  
  52.   IF lc_slash $ lc_result
  53.     lc_result = SUBSTR( lc_result, RAT(lc_slash, lc_result) + 1 )
  54.   ELSE
  55.  
  56.     IF ":" $ lc_result
  57.       lc_result = SUBSTR( lc_result, AT(":", lc_result) + 1 )
  58.     ENDIF
  59.  
  60.   ENDIF
  61.  
  62. RETURN SUBSTR(lc_result, 1, AT(".", lc_result ) - 1 )
  63.  
  64. *-- EOF: _FileRoot( pc_fname )
  65.  
  66.  
  67.  
  68.